home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / EGAVGA.SWG / 0148_Custom Font Creation.pas < prev    next >
Pascal/Delphi Source File  |  1995-03-03  |  8KB  |  228 lines
  1. PROGRAM TESTFONT;
  2. USES VGAfnt,Crt;
  3. VAR I: Integer;
  4. BEGIN               {MAXIMUM STRING LENGTH                39}
  5. VideoMode($13);     {         1         2         3        X}
  6.                     {123456789012345678901234567890123456789}
  7. FOR I:=1 TO 255 DO SetColors(I,(I MOD 63),(I MOD 13)+20,11);
  8. FOR I:=0 TO 255 DO DrawString((I MOD 39)*8,
  9.                                  ((I DIV 39)*9)+1,I,0,Chr(i));
  10. readkey;
  11. VideoMode($3);
  12. END.
  13. {
  14. This driver doesn't draw a string put does display all ascii codes to the
  15. vga screen. Syntax for DrawString is as follows:
  16.           DrawString(Xcor,Ycor,Color,Incr, string);
  17.           Xcor:=x coordinate
  18.           Ycor:=Y coordinate
  19. color:=color to start 1-256 [may be 0-255]
  20. Incr:Number to add to color inbetween chars
  21.                Example     This is a String
  22.  
  23. This first would be color 1, the last color 16.
  24. String:=andy string..andy ascii code up to 39 characters.
  25.  
  26. Char above and beyond 39 will be truncated and not displayed. The code NEEDS
  27. improvement.  If you can do so, then DO SO. Idea's.  Have a defaul font for
  28. EACH graphic video mode. Have it chosen when VideoMode is change, along with
  29. CHarHeight & charWidth. Create a program that allows you to modify each
  30. character WITHOUT having to text edit the FONT.TXT pascal typed structyre.
  31.  
  32.     This program is only a building block. It can be made into a great graphic
  33. font program. Play with it and learn.
  34. }
  35.  
  36. PROGRAM FX; {FonteXtract}
  37. {This program makes a Pascal represenation type of the ascii chart by
  38.  extracting the default font from memory.
  39.  ERRORS: now very few}
  40. VAR   Fl   : Text;
  41.       I    : integer;
  42.       FontAddrSeg,
  43.       FontAddrOfs,
  44.       DOtLines          : word;
  45.  
  46. PROCEDURE GetChar;
  47.  PROCEDURE FontAddr(Font:byte);
  48.  { Returns segment- and offset address of fonts with input of
  49.   a Code, representing the font:
  50.   Font 2 : 8x14 Font
  51.        3 : 8x8 Font, 1. part, ASCII 00h..7Fh
  52.        4 : 8x8 Font, 2. part, ASCII 80h..FFh
  53.        5 : 9*14 substitutes
  54.        6 : VGA 8x16 Font
  55.        7 : VGA 9*16 substitutes }
  56.   BEGIN
  57.    ASM
  58.     push bp       {BP will be changed by this function}
  59.     mov ax,1130h
  60.     mov bh,font
  61.     int 10h
  62.     mov FontAddrSeg,es      {will become $C000}
  63.     mov FontAddrOfs,bp      {offset in VGA-BIOS}
  64.     mov DotLines,cx         {bytes per char}
  65.     pop bp
  66.    END;
  67.   END;  {FontAddr}
  68. VAR NC, BC, IT  :Integer;
  69.     MMC    :word;
  70.     TEMP   :byte;
  71.     DStr        :STRING;
  72.  
  73. BEGIN
  74. DStr:='';
  75. FontAddr(3);
  76. WriteLN(FL, 'Alpha: LettersType = (');
  77. FOR NC:=$0 TO $FF DO BEGIN               {Number of chars in font  }
  78.     WriteLN(FL, '{',NC,'}');              {Title the block by ascii }
  79.     WriteLN(FL,   '(');
  80.     FOR BC:=0 TO 7 DO BEGIN              {Number of rows}
  81.         TEMP:=Mem[FontAddrSeg:
  82.                   FontAddrOfs+(NC*8)+(Bc)];   {Get the first line of the
  83. character}
  84.         FOR IT:=7 DOWNTO 0 DO BEGIN           {Get the bit representation}
  85.             IF (temp AND (1 SHL IT)) <> 0 THEN BEGIN
  86.                DStr:=DStr+'$B';
  87.                IF (BC=7) AND (IT=0) THEN BEGIN
  88.                   IF NC=$FF THEN DStr:=DStr+'));'
  89.                   ELSE DStr:=DStr+'),';
  90.                END
  91.                ELSE DStr:=DStr+',';
  92.             END
  93.             ELSE BEGIN
  94.                DStr:=DStr+' 0';
  95.                IF (BC=7) AND (IT=0) THEN BEGIN
  96.                   IF NC=$FF THEN DStr:=DStr+'));'
  97.                   ELSE DStr:=DStr+'),';
  98.                END
  99.                ELSE DStr:=DStr+',';
  100.             END;
  101.         END;
  102.         WriteLN(FL,DStr);
  103.         DStr:='';                       {Clear dummy string}
  104.     END;
  105.     WriteLN(FL);                        {Separate the blocks}
  106.     END;
  107. END;
  108.  
  109. BEGIN
  110.   assign(FL,'Font.TXT');
  111.   ReWrite(FL);
  112.   GETCHAR;    {get it from Mem and make a representation of it}
  113.   close(FL);
  114. END.
  115.  
  116. {$M 9182,0,0}
  117. { $A+        Align Data ..Word                }
  118. { $B-        Boolean Evaluation..Short Circuit}
  119. { $D-        Debug Information..Off           }
  120. { $E-        Emulation..Off      not needed in units}
  121. { $F-        Force Far Calls..Off             }
  122. { $G-        286 Code..Off                    }
  123. { $I+        I/O Checking..On                 }
  124. { $K-        Smart callbacks..Off             }
  125. { $L-        Local Symbols..Off               }
  126. { $N-        80x87 Code..Off                  }
  127. { $O-        Overlay Code Generaton..Off      }
  128. { $P-        Open string parameters..Disabled }
  129. { $Q-        Overflow Checking..Off           }
  130. { $R-        Range Checking..Off              }
  131. { $S-        Stack Checking..Off              }
  132. { $T-        Type-Checked Pointers..Off       }
  133. { $V-        Relaxed Var-String Checking      }
  134. { $W-        Windows Stack Frame..Off         }
  135. { $X+        Extended Syntax..On              }
  136. { $Y-        Symbol reference information..Off}
  137. UNIT VGAfnt;
  138. INTERFACE
  139. PROCEDURE DrawString(Xcor,YCor,color:WORD; Incr:Integer;line:STRING);
  140.  TYPE PalBuf256 = ARRAY[1..768] OF integer;
  141.   PROCEDURE VideoMode(Mode : BYTE);
  142.   PROCEDURE SetColPal(Color, Red, Gren, Blue : Word);
  143.   PROCEDURE SetColors ( Color, Red, Green, Blue : integer );
  144.   PROCEDURE PutDot(x,y:WoRd;color:integer);
  145.   PROCEDURE Set256Pal( Palbuf: PalBuf256 );
  146. IMPLEMENTATION
  147. TYPE
  148.   BitType      = ARRAY[0..8*8-1] OF word;
  149.   LettersType  = ARRAY[0..255] OF BitType;     {a..z}
  150. CONST
  151.   CharWidth   = 8;
  152.   CharHeight  = 8;
  153.   VGA_Segment = $0A000;
  154.   {coded chart of font made by FX pascal extracter}{$I FONT.TXT }
  155. PROCEDURE VideoMode ( Mode : BYTE );
  156.     BEGIN ASM
  157.         Mov  AH,00
  158.         Mov  AL,Mode
  159.         Int  10h
  160.     END; END;
  161. PROCEDURE SetColPal(Color, Red, Gren, Blue : Word); ASSEMBLER;
  162. ASM
  163.         mov dx,$03c8;      mov ax,color;
  164.         out dx,al;               inc dx;
  165.         mov ax,red;           out dx,al;
  166.         mov ax,gren;          out dx,al;
  167.         mov ax,blue;          out dx,al;
  168. END;
  169. PROCEDURE SetColors ( Color, Red, Green, Blue : integer );
  170. BEGIN
  171.  Port[$3C8] := Color;
  172.  Port[$3C9] := Red;
  173.  Port[$3C9] := Green;
  174.  Port[$3C9] := Blue;
  175. END;
  176. PROCEDURE PutDot(x,y:word;color:integer);
  177. BEGIN            {test}
  178.     Mem[VGA_Segment:((y-1)*320)+x] := color;
  179. END;
  180. PROCEDURE Set256Pal( Palbuf: PalBuf256 );
  181. VAR I : Integer;
  182. BEGIN
  183.   FOR I :=0 TO 255 DO BEGIN
  184.       SetColPal(I, PalBuf[ (I*3)], PalBuf[ (I*3) +1], PalBuf[ (I*3) +2]);
  185.   END;
  186. END;
  187.  
  188. {================ String writin' stuff ===================================}
  189. PROCEDURE DrawString(Xcor,YCor,color:WORD;Incr:Integer;Line:string);
  190. VAR I,Temp,B   : Integer;          {INCR: INC COLOR WITH EACH CHAR}
  191.     Individual: BitType;           {LINE: WHAT TO DRAW}
  192. BEGIN
  193.   FOR I:=1 TO length(Line) DO BEGIN
  194.     IF (line[i]<>' ') AND (Xcor+CharWidth<320) THEN BEGIN
  195.        Individual:=Alpha[ ORd(line[I]) ];
  196.  {Chr} FOR b:=0 TO (CharHeight)* (charWidth)-1 DO BEGIN
  197.        Temp:=Individual[b];
  198.        IF temp<> 0 THEN
  199.            PutDot(Xcor+(B MOD CharWidth),Ycor+(B DIV CharHeight),color);
  200.            {Skip blanks}
  201.  {END} END;
  202.     END;
  203.     Inc(xcor,CharWidth);
  204.     Inc(color,IncR)
  205.   END;
  206. END;
  207. BEGIN
  208. END.
  209.  
  210. (*
  211.     The following code can be used to make and display a single VGA font.
  212.     The first program is FX. It is used to extract an 8x8 default font from
  213. memory and translate it into a pascal typed structure: simple to {$I}nclude
  214. into a unit.
  215.     The Second pogram in VGAfnt. It includes the VGA putdot & SetColors 
  216. procedures used to draw a string to the screen. 
  217.     The third program is a test driver for VGAfnt. It sets the palette and
  218. displays all font chars to the screen.
  219.  
  220.     To run and test FIRST run FX. It will create FONT.TXT, the file to be
  221. included in VGAfnt. SECOND compile VGAfnt with FONT.TXT in the same
  222. directory. THIRD build TESTFONT; this will gather all up and allow you to
  223. quickly test the unit.
  224.  
  225.     Have fun and enjoy. Modifications ARE welcome. Just post you mod.s so
  226. all can enjoy.
  227. *)
  228.